home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / axbutton / timer.cls < prev    next >
Encoding:
Visual Basic class definition  |  1997-10-08  |  2.9 KB  |  85 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "objTimer"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. '-------------------------------------------------------------------------------
  11. ' Copyright ⌐ 1997 Microsoft Corporation. All rights reserved.
  12. '
  13. ' You have a royalty-free right to use, modify, reproduce and distribute the
  14. ' Sample Application Files (and/or any modified version) in any way you find
  15. ' useful, provided that you agree that Microsoft has no warranty, obligations or
  16. ' liability for any Sample Application Files.
  17. '-------------------------------------------------------------------------------
  18.  
  19. '-------------------------------------------------------------------------------
  20. ' Timer object code has been demonstrated before. This implementation contains
  21. ' one slight improvement over some other implementations: It's global collection
  22. ' of timer objects is a keyed list. The items are pointers to the timer objects.
  23. ' The keys are timer IDs (returned by StartTimer). This enables the TimerProc in
  24. ' modTimer to very quickly find the appropriate timer object, given a timer ID.
  25. '-------------------------------------------------------------------------------
  26.  
  27. Option Explicit
  28.  
  29. Public Event Timer()
  30.  
  31. Private Const mnDefaultInterval As Long = 1
  32.  
  33. Private mnTimerID As Long
  34. Private mnInterval As Long
  35. Private mfEnabled As Boolean
  36.  
  37. Public Property Get Interval() As Long
  38.     Interval = mnInterval
  39. End Property
  40. Public Property Let Interval(Value As Long)
  41.     If mnInterval <> Value Then
  42.         mnInterval = Value
  43.         If mfEnabled Then
  44.             SetInterval mnInterval, mnTimerID
  45.         End If
  46.     End If
  47. End Property
  48.  
  49. Public Property Get Enabled() As Boolean
  50.     Enabled = mfEnabled
  51. End Property
  52. Public Property Let Enabled(Value As Boolean)
  53.     If mfEnabled <> Value Then
  54.         If Value Then
  55.             mnTimerID = StartTimer(mnInterval)
  56.             If mnTimerID <> 0 Then
  57.                 mfEnabled = True
  58.                 'Storing Me in the global would add a reference to Me, which
  59.                 '   would prevent Me from being released, which in turn would
  60.                 '   prevent my Class_Terminate code from running. To prevent
  61.                 '   this, I store a "soft reference" - the collection holds a
  62.                 '   pointer to me without incrementing my reference count.
  63.                 gcTimerObjects.Add ObjPtr(Me), mnTimerID
  64.             End If
  65.         Else
  66.             StopTimer mnTimerID
  67.             mfEnabled = False
  68.             gcTimerObjects.Remove mnTimerID
  69.         End If
  70.     End If
  71. End Property
  72.  
  73. Private Sub Class_Initialize()
  74.     If gcTimerObjects Is Nothing Then Set gcTimerObjects = New SortedList
  75.     mnInterval = mnDefaultInterval
  76. End Sub
  77.  
  78. Private Sub Class_Terminate()
  79.     Enabled = False
  80. End Sub
  81.  
  82. Friend Sub Tick()
  83.     RaiseEvent Timer
  84. End Sub
  85.